Internet Info 1993

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1993 / Internet Info CD-ROM (Walnut Creek) (1993).iso / networking / terms / kermit / d / k12dec.pal < prev next >

Wrap

Text File | 1992-07-11 | 32.8 KB | 1,017 lines

/ OS/8 DECODING PROGRAM / LAST EDIT: 08-JUL-1992 22:00:00 CJL / PROGRAM TO DECODE OS/8 FILES FROM "PRINTABLE" ASCII FORMAT TO BINARY-IMAGE / FORMAT. INTERMEDIATE "ASCII" CONVERSION SHOULD BE HARMLESS AS LONG AS ALL / PRINTING DATA CHARACTERS ARE NOT MODIFIED. / DISTRIBUTED BY CUCCA AS "K12DEC.PAL" AS PART OF THE CUCCA KERMIT-12 PACKAGE. / WRITTEN BY: / CHARLES LASNER (CJL) / CLA SYSTEMS / 72-55 METROPOLITAN AVENUE / MIDDLE VILLAGE, NEW YORK 11379-2107 / (718) 894-6499 / USAGE: / THIS PROGRAM OPERATES ON "PRINTABLE" ASCII FILES WHICH HAVE BEEN CREATED BY / ENCODING THE CONTENTS OF ARBITRARY (BINARY) FILES. THE ENCODING FORMAT ALLOWS / FOR SOME INNOCUOUS CONTENT MODIFICATION SUCH AS EXTRANEOUS WHITE SPACE AND / EXTRA <CR>/<LF> PAIRS, BUT RIGOROUSLY VALIDATES CERTAIN ASPECTS OF THE FORMAT, / SUCH AS A TRAILING CHECKSUM. / CERTAIN IMBEDDED COMMANDS ARE USED SUCH AS (REMARK .........) WHICH ALLOWS FOR / COMMENTARY LINES WITHIN THE FILE FOR IDENTIFICATION PURPOSES. THE (FILE ) AND / (END ) COMMANDS CONTAIN THE SUGGESTED FILENAME FOR THE DESCENDANT DECODED / FILE. / WHEN CREATING THE DESCENDANT DECODED FILE, THE USER MAY SPECIFY EITHER THE / IMBEDDED FILENAME OR AN ALTERNATE FILENAME ON EITHER THE DEFAULT (DSK:) DEVICE / OR A SPECIFIED DEVICE: / .RUN DEV DECODE INVOKE PROGRAM. / *INPUT INPUT IS DECODED INTO IMBEDDED NAME ON DSK: (DEFAULT). / *DEV:OUTPUT.EX<INPUT INPUT IS DECODED INTO OUTPUT.EX ON DEVICE DEV:. / *DEV:<INPUT INPUT IS DECODED INTO IMBEDDED NAME ON DEVICE DEV:. / *DEV:<INPUT=NNNN/I **** SPECIAL IMAGE TRANSFER MODE **** INPUT IS DECODED / INTO RECORD 0000-[NNNN-1] ON DEVICE DEV:. THE =NNNN / VALUE SHOULD BE CAREFULLY CHOSEN LARGE ENOUGH TO WRITE / ALL DATA RECORDS, BUT NEED NOT BE STATED EXACTLY. / (THE ENCODE PROGRAM REQUIRES PRECISE STATEMENT OF THE / LENGTH IN IMAGE TRANSFER ENCODING MODE. **** NOTE / **** THIS METHOD VIOLATES ALL OS/8 DEVICE STRUCTURE / AND IS MEANT FOR TRANSFER OF COMPLETE DEVICE IMAGES / ONLY; USE WITH CARE! / *DEV:<INPUT=NNNN/I/1 **** SPECIAL IMAGE TRANSFER MODE **** SAME AS REGULAR / IMAGE MODE EXCEPT ONLY THE FIRST HALF OF THE DATA IS / USED. NOTE THAT THE =NNNN VALUE MUST BE GIVEN EXACTLY / BECAUSE IT IS USED TO CALCULATE THE APPROX. 1/2 VALUE / ACTUALLY USED IN THIS HALF OF THE OVERALL TRANSFER. / THIS MODE SHOULD BE USED WITH FILES CREATED FOR THE / EXPRESS PURPOSE OF TRANSMISSION BY HALVES ONLY; USE / WITH CARE! / *DEV:<INPUT=NNNN/I/2 **** SPECIAL IMAGE TRANSFER MODE **** SAME AS REGULAR / IMAGE MODE EXCEPT ONLY THE SECOND HALF OF THE DATA IS / USED. NOTE THAT THE =NNNN VALUE MUST BE GIVEN EXACTLY / BECAUSE IT IS USED TO CALCULATE THE STARTING RECORD OF / THE APPROX. 1/2 VALUE ACTUALLY USED IN THIS HALF OF / THE OVERALL TRANSFER. THIS MODE SHOULD BE USED WITH / FILES CREATED FOR THE EXPRESS PURPOSE OF TRANSMISSION / BY HALVES ONLY; USE WITH CARE! NOTE THAT THERE MUST / BE TWO FILES CREATED, ONE USING /I/1 AND THE OTHER / USING /I/2 TO COMPLETELY TRANSFER A DEVICE IMAGE / UNLESS /I IS USED ALONE! / *OUTPUT.EX<INPUT$ INPUT IS DECODED INTO OUTPUT.EX ON DSK: (DEFAULT). / THE <ESC> CHARACTER WAS USED TO TERMINATE THE LINE / (THIS IS SIGNIFIED BY $). THIS CAUSES PROGRAM EXIT. / . PROGRAM EXITS NORMALLY. / INPUT FILE ASSUMES .EN EXTENSION; THERE IS NO ASSUMED OUTPUT EXTENSION. / IMAGE TRANSFER MODE DOESN'T USE OUTPUT FILENAMES, AS THE TRANSFER DESTROYS THE / OS/8 FILE STRUCTURE (POSSIBLY PRESENT) ON THE DEVICE. / PROGRAM EXIT IS THE NORMAL OS/8 METHOD OF EITHER PRESSING <^C> ON THE CONSOLE / KEYBOARD DURING THE COMMAND, OR ENDING THE COMMAND INPUT LINE WITH AN <ESC> / CHARACTER. / THIS PROGRAM SUPPORTS A PROPER SUBSET OF THE ASCII ENCODING SCHEME DISCUSSED / BY CHARLES LASNER AND FRANK DA CRUZ. THE SCHEME USED IS FIVE-BIT ENCODING / WITH COMPRESSION, (AS OPPOSED TO SIX-BIT WITHOUT COMPRESSION AS USED IN PRIOR / VERSIONS). / RESTRICTIONS: / A) SUPPORTS ONLY ONE DECODABLE FILE PER ENCODED FILE. / B) IGNORES ALL (END ) COMMANDS. / C) <CR> <LF> < ALWAYS INDICATES ENCODED DATA LINES; NO CHECK IS MADE FOR / WHETHER THE > IS ON THE SAME LINE AS THE <. / D) PDP-8 GENERATED CHECKSUM DATA MUST BE THE FINAL DATA IN THE FILE IN / THE PROPER FORMAT: ZCCCCCCCCCCCC WHERE CCCCCCCCCCCC IS THE / TWELVE-CHARACTER PDP-8 CHECKSUM DATA. / IF THE ENCODED FILE IS PASSED THROUGH ANY INTERMEDIARY PROCESS THAT MODIFIES / THE CONTENTS IN A WAY THAT INTERFERES WITH ANY OF THE ABOVE, THIS DECODING / PROGRAM WILL FAIL. IT IS THE USER'S RESPONSIBILITY TO EDIT OUT UNWANTED / CHANGES TO THE ENCODED FILE. ALL OTHER ASPECTS OF THE PROTOCOL ARE OBEYED, / SUCH AS IMBEDDED <FF>, EXTRA <CR> <LF>, OR TRAILING SPACES HAVE NO EFFECT ON / THE RELIABILITY OF THE DECODING PROCESS, ETC. / ERROR MESSAGES. / ANY MESSAGE PRINTED IS A FATAL ERROR MESSAGE. ALL MESSAGES ARE THE STANDARD / OS/8 "USER" ERROR MESSAGES OF THE FORM: USER ERROR X AT AAAAA WHERE X IS THE / ERROR NUMBER AND AAAAA IS THE PROGRAM ADDRESS WHERE THE ERROR WAS DETECTED. / THE FOLLOWING USER ERRORS ARE DEFINED: / ERROR NUMBER PROBABLE CAUSE / 0 TOO MANY OUTPUT FILES. / 1 NO INPUT FILE OR TOO MANY INPUT FILES. / 2 IMBEDDED OUTPUT FILENAME FORMAT ERROR. / 3 I/O ERROR WHILE LOCATING IMBEDDED OUTPUT FILENAME. / 4 ERROR WHILE FETCHING FILE HANDLER. / 5 ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE. / 6 OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE. / 7 ERROR WHILE CLOSING THE OUTPUT FILE. / 8 I/O ERROR WHILE DECODING FILE DATA OR BAD DATA. / ASSEMBLY INSTRUCTIONS. / IT IS ASSUMED THE SOURCE FILE K12DEC.PAL HAS BEEN MOVED AND RENAMED TO / DSK:DECODE.PA. / .PAL DECODE<DECODE ASSEMBLE SOURCE PROGRAM / .LOAD DECODE LOAD THE BINARY FILE / .SAVE DEV DECODE=0 SAVE THE CORE-IMAGE FILE / DEFINITIONS. CLOSE= 4 /CLOSE OUTPUT FILE DECODE= 5 /CALL COMMAND DECODER ENTER= 3 /ENTER TENTATIVE FILE EQUWRD= 7646 /EQUALS PARAMETER HERE IN TABLE FIELD FETCH= 1 /FETCH HANDLER IHNDBUF=7200 /INPUT HANDLER BUFFER INBUFFE=6200 /INPUT BUFFER INFILE= 7617 /INPUT FILE INFORMATION HERE INQUIRE=12 /INQUIRE ABOUT HANDLER NL0001= CLA IAC /LOAD AC WITH 0001 NL0002= CLA CLL CML RTL /LOAD AC WITH 0002 NL4000= CLA CLL CML RAR /LOAD AC WITH 4000 NL7776= CLA CLL CMA RAL /LOAD AC WITH 7776 NL7777= CLA CMA /LOAD AC WITH 7777 OHNDBUF=6600 /OUTPUT HANDLER BUFFER OUTBUFF=5600 /OUTPUT BUFFER OUTFILE=7600 /OUTPUT FILE INFORMATION HERE PRGFLD= 00 /PROGRAM FIELD RESET= 13 /RESET SYSTEM TABLES SBOOT= 7600 /MONITOR EXIT SWAL= 7643 /A-/L SWITCHES HERE IN TABLE FIELD SWY9= 7645 /Y-/9 SWITCHES HERE IN TABLE FIELD TBLFLD= 10 /COMMAND DECODER TABLE FIELD TERMWRD=7642 /TERMINATOR WORD USERROR=7 /USER SIGNALLED ERROR USR= 7700 /USR ENTRY POINT USRFLD= 10 /USR FIELD WIDTH= 107-2 /69 DATA CHARACTERS PER LINE (TOTAL 71) WRITE= 4000 /I/O WRITE BIT *0 /START AT THE BEGINNING *10 /DEFINE AUTO-INDEX AREA XR1, .-. /AUTO-INDEX NUMBER 1 XR2, .-. /AUTO-INDEX NUMBER 2 *20 /GET PAST AUTO-INDEX AREA BUFPTR, .-. /OUTPUT BUFFER POINTER CCNT, .-. /CHECKSUM COUNTER CHKSUM, ZBLOCK 5 /CHECKSUM TEMPORARY CHRCNT, .-. /CHARACTER COUNTER CSUMTMP,.-. /CHECKSUM TEMPORARY DANGCNT,.-. /DANGER COUNT DATCNT, .-. /DATA COUNTER DSTATE, .-. /DATA STATE VARIABLE IDNUMBE,.-. /INPUT DEVICE NUMBER IMSW, .-. /IMAGE-MODE SWITCH INITFLA,.-. /INITIALIZE INPUT FLAG INPUT, .-. /INPUT HANDLER POINTER INRECOR,.-. /INPUT RECORD FCHKSUM,ZBLOCK 5 /FILE CHECKSUM FNAME, ZBLOCK 4 /OUTPUT FILENAME GWTMP1, .-. /GETWORD TEMPORARY GWTMP2, .-. /GETWORD TEMPORARY GWVALUE,.-. /LATEST WORD VALUE ODNUMBE,.-. /OUTPUT DEVICE NUMBER OUTPUT, .-. /OUTPUT HANDLER POINTER OUTRECO,.-. /OUTPUT RECORD PUTEMP, .-. /OUTPUT TEMPORARY PUTPTR, .-. /OUTPUT POINTER THIRD, .-. /THIRD BYTE TEMPORARY / STATE TABLE. P, SCANIT /0000 LOOKING FOR "(" OR "<" FNDCOMMAND /0001 FOUND "(" AND NOW LOOKING FOR ")" FNDCEND /0002 FOUND ")" AND NOW LOOKING FOR <CR> FNDCR /0003 FOUND <CR> AND NOW LOOKING FOR <LF> TO RESET STORDATA /4000 FOUND "<" AND PROCESSING 69 DATA BYTES ENDATA /4001 FOUND 69 DATA BYTES AND NOW LOOKING FOR ">" ENDCR /4002 FOUND ">" AND NOW LOOKING FOR <CR> FNDCR/ENDLF /4003 FOUND <CR> AND NOW LOOKING FOR <LF> TO RESET PAGE /START AT THE USUAL PLACE BEGIN, NOP /HERE IN CASE WE'RE CHAINED TO CLA /CLEAN UP START, CIF USRFLD /GOTO USR FIELD JMS I [USR] /CALL USR ROUTINE DECODE /WANT COMMAND DECODER "E^100+"N-300 /.EN IS DEFAULT EXTENSION CDF TBLFLD /GOTO TABLE FIELD TAD I (TERMWRD) /GET TERMINATOR WORD SPA CLA /SKIP IF <CR> TERMINATED THE LINE DCA EXITZAP /ELSE CAUSE EXIT LATER DCA IMSW /CLEAR IMAGE-MODE; MIGHT GET SET LATER THOUGH TAD I (OUTFILE) /GET FIRST OUTPUT FILE DEVICE WORD SNA /SKIP IF FIRST OUTPUT FILE PRESENT JMP TSTMORE /JUMP IF NOT THERE AND [17] /JUST DEVICE BITS ODNULL, DCA ODNUMBER /SAVE OUTPUT DEVICE NUMBER TAD I (OUTFILE+5) /GET SECOND OUTPUT FILE DEVICE WORD SNA /SKIP IF THERE TAD I (OUTFILE+12) /ELSE GET THIRD OUTPUT FILE DEVICE WORD SZA CLA /SKIP IF BOTH NOT PRESENT JMP I (OUTERR) /ELSE COMPLAIN TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD SNA /SKIP IF PRESENT JMP I (INERR) /JUMP IF NOT AND [17] /JUST DEVICE BITS DCA IDNUMBER /SAVE INPUT DEVICE NUMBER TAD I (INFILE+2) /GET SECOND INPUT FILE DEVICE WORD SZA CLA /SKIP IF ONLY ONE INPUT FILE JMP I (INERR) /ELSE COMPLAIN TAD I (INFILE+1) /GET FIRST INPUT FILE STARTING RECORD DCA INRECORD /SET IT UP CDF PRGFLD /BACK TO OUR FIELD CIF USRFLD /GOTO USR FIELD JMS I [USR] /CALL USR ROUTINE RESET /RESET SYSTEM TABLES TAD (IHNDBUFFER+1) /GET INPUT BUFFER POINTER+TWO-PAGE BIT DCA IHPTR /STORE IN-LINE TAD IDNUMBER /GET INPUT DEVICE NUMBER CIF USRFLD /GOTO USR FIELD JMS I [USR] /CALL USR ROUTINE FETCH /FETCH HANDLER IHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT JMP I (FERROR) /FETCH ERROR TAD IHPTR /GET RETURNED ADDRESS DCA INPUT /STORE AS INPUT HANDLER ADDRESS JMS I (GEOFILE) /GET OUTPUT FILE INFORMATION TAD (OHNDBUFFER+1) /GET BUFFER POINTER+TWO-PAGE BIT DCA OHPTR /STORE IN-LINE TAD ODNUMBER /GET OUTPUT DEVICE NUMBER CIF USRFLD /GOTO USR FIELD JMS I [USR] /CALL USR ROUTINE FETCH /FETCH HANDLER OHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT JMP I (FERROR) /FETCH ERROR TAD OHPTR /GET RETURNED ADDRESS DCA OUTPUT /STORE AS OUTPUT HANDLER ADDRESS TAD IMSW /GET IMAGE-MODE SWITCH SNA CLA /SKIP IF SET JMP NOIMAGE /JUMP IF NOT / IF /2 IS SET, THE DATA STARTS HALF-WAY INTO THE IMAGE. OTHER IMAGE MODES / START AT RECORD 0000. CDF TBLFLD /GOTO TABLE FIELD TAD I [SWY9] /GET /Y-/9 SWITCHES AND (200) /JUST /2 SWITCH SNA CLA /SKIP IF SET JMP IMAGE1 /JUMP IF /1 OR NEITHER /1, /2 SET TAD I [EQUWRD] /GET EQUALS PARAMETER CLL RAR /%2 IMAGE1, DCA OUTRECORD /STORE STARTING OUTPUT RECORD CDF PRGFLD /BACK TO OUR FIELD SKP /DON'T ENTER FILE NAME NOIMAGE,JMS I (FENTER) /ENTER THE TENTATIVE FILE NAME DCA DSTATE /SET INITIAL DATA STATE JMS I (CLRCHKSUM) /CLEAR OUT CHECKSUM JMS I (DECODIT) /GO DO THE ACTUAL DECODING JMP I (PROCERR) /ERROR WHILE DECODING TAD IMSW /GET IMAGE-MODE SWITCH SZA CLA /SKIP IF CLEAR JMP EXITZAP /JUMP IF SET TAD ODNUMBER /GET OUTPUT DEVICE NUMBER CIF USRFLD /GOTO USR FIELD JMS I [USR] /CALL USR ROUTINE CLOSE /CLOSE OUTPUT FILE FNAME /POINTER TO FILENAME OUTCNT, .-. /WILL BE ACTUAL COUNT JMP I (CLSERR) /CLOSE ERROR EXITZAP,JMP START /**** <ESC> TERMINATION **** 0000 JMP I (SBOOT) /EXIT TO MONITOR / COMES HERE TO TEST FOR NULL LINE. TSTMORE,TAD I (OUTFILE+5) /GET SECOND OUTPUT FILE DEVICE WORD SNA /SKIP IF PRESENT TAD I (OUTFILE+12) /ELSE GET THIRD OUTPUT FILE DEVICE WORD SZA CLA /SKIP IF NO OUTPUT FILES JMP I (OUTERR) /ELSE COMPLAIN OF SECOND/THIRD (WITHOUT FIRST) OUTPUT TAD I (INFILE) /GET FIRST OUTPUT FILE DEVICE WORD SZA CLA /SKIP IF NO INPUT FILES JMP ODNULL /JUMP IF INPUT WITHOUT OUTPUT CDF PRGFLD /BACK TO OUR FIELD JMP EXITZAP /MIGHT BE LAST TIME, SO GO THERE FIRST PAGE / ERROR WHILE PROCESSING INPUT FILE. PROCERR,NL0002 /SET INCREMENT SKP /DON'T USE NEXT / ERROR WHILE CLOSING THE OUTPUT FILE. CLSERR, NL0001 /SET INCREMENT SKP /DON'T CLEAR IT / OUTPUT FILE TOO LARGE ERROR. SIZERR, CLA /CLEAN UP TAD [3] /SET INCREMENT SKP /DON'T USE NEXT / ENTER ERROR. ENTERR, NL0002 /SET INCREMENT SKP /DON'T USE NEXT / HANDLER FETCH ERROR. FERROR, NL0001 /SET INCREMENT / I/O ERROR WHILE PROCESSING (FILE ) COMMAND. NIOERR, IAC /SET INCREMENT / FORMAT ERROR WHILE PROCESSING (FILE ) COMMAND. CHARERR,IAC /SET INCREMENT / INPUT FILESPEC ERROR. INERR, IAC /SET INCREMENT / OUTPUT FILESPEC ERROR. OUTERR, DCA ERRNUMBER /STORE ERROR NUMBER CDF PRGFLD /ENSURE OUR FIELD CIF USRFLD /GOTO USR FIELD JMS I [USR] /CALL USR ROUTINE USERROR /USER ERROR ERRNUMB,.-. /WILL BE PASSED ERROR NUMBER DECODIT,.-. /DECODING ROUTINE TAD OUTRECORD /GET STARTING RECORD OF TENTATIVE FILE DCA PUTRECORD /STORE IN-LINE DCA I (OUTCNT) /CLEAR ACTUAL FILE LENGTH NL7777 /SETUP THE DCA INITFLAG /INITIALIZE FLAG TAD (GWLOOP) /INITIALIZE THE DCA I (GWNEXT) /DECODE PACK ROUTINE PUTNEWR,TAD POUTBUFFER/(OUTBUFFER) /SETUP THE DCA PUTPTR /OUTPUT BUFFER POINTER PUTLOOP,JMS I (GETWORD) /GET A WORD DCA I PUTPTR /STORE IT ISZ PUTPTR /BUMP TO NEXT TAD PUTPTR /GET THE POINTER TAD (-2^200-OUTBUFFER) /COMPARE TO LIMIT SZA CLA /SKIP IF AT END JMP PUTLOOP /KEEP GOING ISZ DANGCNT /TOO MANY RECORDS? SKP /SKIP IF NOT JMP I (SIZERROR) /NOT ENOUGH SPACE AVAILABLE JMS I OUTPUT /CALL OUTPUT HANDLER 2^100+WRITE /WRITE LATEST RECORD POUTBUF,OUTBUFFER /OUTPUT BUFFER ADDRESS PUTRECO,.-. /WILL BE LATEST RECORD NUMBER DECERR, JMP I DECODIT /I/O ERROR ISZ PUTRECORD /BUMP TO NEXT RECORD NOP /JUST IN CASE ISZ I (OUTCNT) /BUMP ACTUAL LENGTH JMP PUTNEWRECORD /GO DO ANOTHER ONE / GOOD RETURN HERE. DECBMP, ISZ DECODIT /BUMP TO GOOD RETURN JMP I DECODIT /RETURN / OS/8 FILE UNPACK ROUTINE. GETBYTE,.-. /GET A BYTE ROUTINE SNA CLA /INITIALIZING? JMP I PUTC /NO, GO GET NEXT BYTE TAD INRECORD /GET STARTING RECORD OF INPUT FILE DCA GETRECORD /STORE IN-LINE GETNEWR,JMS I INPUT /CALL I/O HANDLER 2^100 /READ TWO PAGES INTO BUFFER INBUFFER /BUFFER ADDRESS GETRECO,.-. /WILL BE LATEST RECORD NUMBER JMP I GETBYTE /INPUT ERROR! TAD (INBUFFER) /SETUP THE DCA BUFPTR /BUFFER POINTER GETLOOP,DCA THIRD /CLEAR THIRD BYTE NOW JMS PUTONE /OBTAIN AND SEND BACK FIRST BYTE JMS PUTONE /OBTAIN AND SEND BACK SECOND BYTE TAD THIRD /GET THIRD BYTE JMS PUTC /SEND IT BACK TAD BUFPTR /GET THE POINTER TAD (-2^200-INBUFFER) /COMPARE TO LIMIT SZA CLA /SKIP IF AT END JMP GETLOOP /KEEP GOING ISZ GETRECORD /BUMP TO NEXT RECORD JMP GETNEWRECORD /GO DO ANOTHER ONE PUTONE, .-. /SEND BACK A BYTE ROUTINE TAD I BUFPTR /GET LATEST WORD AND (7400) /JUST THIRD-BYTE NYBBLE CLL RAL /MOVE UP TAD THIRD /GET OLD NYBBLE (IF ANY) RTL;RTL /MOVE UP NYBBLE BITS DCA THIRD /SAVE FOR NEXT TIME TAD I BUFPTR /GET LATEST WORD AGAIN JMS PUTC /SEND BACK CURRENT BYTE ISZ BUFPTR /BUMP TO NEXT WORD JMP I PUTONE /RETURN PUTC, .-. /SEND BACK LATEST BYTE ROUTINE AND (177) /KEEP ONLY GOOD BITS TAD (-"Z!300) /COMPARE TO <^Z> SNA /SKIP IF NOT ASCII <EOF> JMP GETEOF /JUMP IF ASCII MODE <EOF> TAD ("Z&37) /RESTORE THE CHARACTER ISZ GETBYTE /BUMP PAST <EOF> RETURN GETEOF, ISZ GETBYTE /BUMP PAST I/O ERROR RETURN JMP I GETBYTE /RETURN TO MAIN CALLER PAGE / GET A DECODED WORD ROUTINE. GETWORD,.-. /GET A WORD ROUTINE JMP I GWNEXT /GO WHERE YOU SHOULD GO GWNEXT, .-. /EXIT ROUTINE SNL /SKIP IF CHECKSUM PREVENTED JMS I (DOCHECK) /ELSE DO CHECKSUM JMP I GETWORD /RETURN TO MAIN CALLER / COMES HERE TO PROCESSED COMPRESSED DATA. GWX, JMS I (GETCHR) /GET NEXT CHARACTER JMS I (GWORD0) /GET 12-BIT WORD JMS I (DOCHECK) /INCLUDE IN CHECKSUM DCA GWVALUE /SAVE AS COMPRESSED VALUE TAD GWTMP2 /GET LATEST CHARACTER AND [7] /ISOLATE BITS[9-11] CLL RTR;RTR /BITS[9-11] => AC[0-2] DCA GWTMP1 /SAVE FOR NOW JMS GBIHEXBINARY /GET A CHARACTER CLL RTL;RTL /BITS[7-11] => AC[3-7] TAD GWTMP1 /ADD ON BITS[0-2] JMS I (DOCHECK) /INCLUDE IN CHECKSUM CLL RTR;RTR /BITS[0-7] => AC[4-11] SNA /SKIP IF NOT 256 TAD [400] /000 => 256 CIA /INVERT FOR COUNTING DCA GWTMP1 /SAVE AS REPEAT COUNTER GWXLUP, TAD GWVALUE /GET THE VALUE STL /PREVENT CHECKSUMMING IT JMS GWNEXT /RETURN IT TO THEM ISZ GWTMP1 /DONE ENOUGH? JMP GWXLUP /NO, KEEP GOING / COMES HERE TO INITIATE ANOTHER DATA GROUP. GWLOOP, JMS I (GETCHR) /GET LATEST FILE CHARACTER TAD (-"Z!200) /COMPARE TO EOF INDICATOR SNA /SKIP IF OTHER JMP GWZ /JUMP IF IT MATCHES TAD (-"X+"Z) /COMPARE TO COMPRESSION INDICATOR SNA CLA /SKIP IF OTHER JMP GWX /JUMP IF IT MATCHES TAD PUTEMP /GET THE CHARACTER BACK JMS I (GWORD0) /GET A 12-BIT WORD JMS GWNEXT /RETURN IT JMS I (GWORD1) /GET NEXT 12-BIT WORD JMS GWNEXT /RETURN IT JMS I (GWORD2) /GET NEXT 12-BIT WORD JMS GWNEXT /RETURN IT JMS I (GWORD3) /GET NEXT 12-BIT WORD JMS GWNEXT /RETURN IT JMS I (GWORD4) /GET NEXT 12-BIT WORD JMS GWNEXT /RETURN IT JMP GWLOOP /KEEP GOING / COMES HERE WHEN EOF INDICATOR FOUND. GWZ, TAD (FCHKSUM-1) /SETUP THE DCA XR1 /CHECKSUM POINTER JMS I (GETCHR) /GET NEXT CHARACTER JMS I (GWORD0) /GET A 12-BIT WORD DCA I XR1 /STORE IT JMS I (GWORD1) /GET NEXT WORD DCA I XR1 /STORE IT JMS I (GWORD2) /GET NEXT WORD DCA I XR1 /STORE IT JMS I (GWORD3) /GET NEXT WORD DCA I XR1 /STORE IT JMS I (GWORD4) /GET NEXT WORD DCA I XR1 /STORE IT TAD (CHKSUM-1) /POINT TO DCA XR1 /CALCULATED CHECKSUM TAD (FCHKSUM-1) /POINT TO DCA XR2 /FILE CHECKSUM TAD [-5] /SETUP THE DCA CCNT /COMPARE COUNT CLL /CLEAR LINK FOR TEST GWCMPLP,RAL /GET CARRY TAD I XR1 /GET A CALCULATED WORD TAD I XR2 /COMPARE TO FILE WORD SZA CLA /SKIP IF OK JMP I (DECERR) /ELSE COMPLAIN ISZ CCNT /DONE ALL? JMP GWCMPLP /NO, KEEP GOING / THE CHECKSUM IS OK, CHECK IF FILE ENDED IN A PLAUSIBLE PLACE. TAD PUTPTR /GET OUTPUT POINTER TAD (-OUTBUFFER-4) /COMPARE TO LIMIT SMA SZA CLA /SKIP IF GOOD VALUE JMP I (DECERROR) /JUMP IF NOT / THE FILE ENDED OK, THERE WERE POSSIBLY A FEW CHARACTERS LEFTOVER BECAUSE OF / ALIGNMENT CONSIDERATIONS. THEY SHOULD BE IGNORED SINCE OS/8 FILES ARE / MULTIPLES OF WHOLE RECORDS. JMP I (DECBMP) /RETURN WITH ALL OK GBIHEXB,.-. /GET BINARY VALUE OF BIHEXADECIMAL CHARACTER CLA /CLEAN UP TAD GBIHEXBINARY /GET OUR CALLER DCA BIHEXBINARY /MAKE IT THEIRS JMS I (GETCHR) /GET A CHARACTER SKP /DON'T EXECUTE HEADER! BIHEXBI,.-. /CONVERT BIHEXADECIMAL TO BINARY TAD (-"A!200) /COMPARE TO ALPHABETIC LIMIT SMA /SKIP IF LESS TAD ("9+1-"A) /ELSE ADD ON ALPHABETIC OFFSET TAD (-"0+"A) /MAKE IT BINARY, NOT ASCII DCA GWTMP2 /SAVE IT TAD GWTMP2 /GET IT BACK JMP I BIHEXBINARY /RETURN PAGE / GET WORD[0] ROUTINE. AC MUST ALREADY CONTAIN THE FIRST BI-HEXADECIMAL / CHARACTER. GWORD0, .-. /GET 12-BIT WORD[0] JMS I (BIHEXBINARY) /CONVERT PASSED VALUE TO BINARY CLL RTR;RTR;RTR /BITS[7-11] => AC[0-4] DCA GWTMP1 /SAVE FOR NOW JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY CLL RTL /BITS[7-11] => AC[5-9] TAD GWTMP1 /ADD ON BITS[0-4] DCA GWTMP1 /SAVE FOR NOW JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY RTR;RAR /BITS[7-8] => AC[10-11] AND [3] /ISOLATE BITS[10-11] TAD GWTMP1 /ADD ON BITS[0-9] CLL /CLEAR LINK JMP I GWORD0 /RETURN / GET WORD[1] ROUTINE. GWORD0 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS / THE PREVIOUS CHARACTER. GWORD1, .-. /GET 12-BIT WORD[1] TAD GWTMP2 /GET PREVIOUS CHARACTER AND [7] /ISOLATE BITS[9-11] CLL RTR;RTR /BITS[9-11] => AC[0-2] DCA GWTMP1 /SAVE FOR NOW JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY CLL RTL;RTL /BITS[7-11] => AC[3-7] TAD GWTMP1 /ADD ON BITS[0-2] DCA GWTMP1 /SAVE FOR NOW JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY CLL RAR /BITS[7-10] => AC[8-11] TAD GWTMP1 /ADD ON BITS[0-7] CLL /CLEAR LINK JMP I GWORD1 /RETURN / GET WORD[2] ROUTINE. GWORD1 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS / THE PREVIOUS CHARACTER. GWORD2, .-. /GET 12-BIT WORD[2] TAD GWTMP2 /GET PREVIOUS CHARACTER RAR;CLA RAR /BIT[11] => AC[0] DCA GWTMP1 /SAVE FOR NOW JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY CLL RTL;RTL;RTL /BITS[7-11] => AC[1-5] TAD GWTMP1 /ADD ON BIT[0] DCA GWTMP1 /SAVE FOR NOW JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY CLL RAL /BITS[7-11] => AC[6-10] TAD GWTMP1 /ADD ON BITS[0-5] DCA GWTMP1 /SAVE FOR NOW JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY AND (20) /ISOLATE BIT[7] CLL RTR;RTR /BIT[7] => AC[11] TAD GWTMP1 /ADD ON BITS[0-10] CLL /CLEAR LINK JMP I GWORD2 /RETURN / GET WORD[3] ROUTINE. GWORD2 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS / THE PREVIOUS CHARACTER. GWORD3, .-. /GET 12-BIT WORD[3] TAD GWTMP2 /GET PREVIOUS CHARACTER CLL RTR;RTR;RAR /BITS[8-11] => AC[0-3] DCA GWTMP1 /SAVE FOR NOW JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY CLL RTL;RAL /BITS[7-11] => AC[4-8] TAD GWTMP1 /ADD ON BITS[0-3] DCA GWTMP1 /SAVE FOR NOW JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY RTR /BITS[7-9] => AC[9-11] AND [7] /ISOLATE BITS[9-11] TAD GWTMP1 /ADD ON BITS[0-8] CLL /CLEAR LINK JMP I GWORD3 /RETURN / GET WORD[4] ROUTINE. GWORD3 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS / THE PREVIOUS CHARACTER. GWORD4, .-. /GET 12-BIT WORD[4] TAD GWTMP2 /GET PREVIOUS CHARACTER AND [3] /ISOLATE BITS[10-11] CLL RTR;RAR /BITS[10-11] => AC[0-1] DCA GWTMP1 /SAVE FOR NOW JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY CLL RTL;RTL;RAL /BITS[7-11] => AC[2-6] TAD GWTMP1 /ADD ON BITS[0-1] DCA GWTMP1 /SAVE FOR NOW JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY TAD GWTMP1 /ADD ON BITS[0-6] TO BITS[7-11] CLL /CLEAR LINK JMP I GWORD4 /RETURN DOCHECK,.-. /CHECKSUM ROUTINE DCA CSUMTMP /SAVE PASSED VALUE TAD (CHKSUM-1) /SETUP THE DCA XR1 /INPUT POINTER TAD (CHKSUM-1) /SETUP THE DCA XR2 /OUTPUT POINTER TAD [-5] /SETUP THE DCA CCNT /SUM COUNT TAD CSUMTMP /GET THE VALUE CLL RAR /ADJUST FOR OPENING ITERATION CSUMLUP,RAL /GET CARRY TAD I XR1 /ADD ON A WORD DCA I XR2 /STORE BACK ISZ CCNT /DONE ALL YET? JMP CSUMLUP /NO, KEEP GOING TAD CSUMTMP /GET LATEST VALUE JMP I DOCHECK /RETURN PAGE GETCHR, .-. /GET A VALID CHARACTER ROUTINE GETMORE,TAD INITFLAG /GET INITIALIZE FLAG JMS I [GETBYTE] /GET A CHARACTER JMP I (DECERR) /I/O ERROR JMP I (DECERR) /<EOF> DCA PUTEMP /SAVE THE CHARACTER DCA INITFLAG /CLEAR INITIALIZE FLAG TAD DSTATE /GET DATA STATE SPA /SKIP IF NOT ONE OF THE DATA-ORIENTED STATES TAD (4004) /ADD ON DATA-ORIENTED STATES OFFSET TAD (JMP I P) /SETUP JUMP INSTRUCTION DCA .+1 /STORE IN-LINE .-. /AND EXECUTE IT / LOOKING FOR OPENING CHARACTER. SCANIT, TAD PUTEMP /GET THE CHARACTER TAD (-"<!200) /COMPARE TO OPENING DATA CHARACTER SNA /SKIP IF NO MATCH JMP FNDATA /JUMP IF IT MATCHES TAD (-"(+"<) /COMPARE TO OPENING COMMAND CHARACTER SNA CLA /SKIP IF NO MATCH ISZ DSTATE /INDICATE LOOKING FOR END OF COMMAND JMP GETMORE /KEEP GOING / FOUND OPENING COMMAND CHARACTER. FNDCOMM,TAD PUTEMP /GET THE CHARACTER TAD (-")!200) /COMPARE TO CLOSING COMMAND CHARACTER SNA CLA /SKIP IF NO MATCH ISZ DSTATE /INDICATE LOOKING FOR <CR> JMP GETMORE /KEEP GOING / FOUND CLOSING COMMAND CHARACTER. FNDCEND,TAD PUTEMP /GET THE CHARACTER TAD (-"M!300) /COMPARE TO <CR> SNA CLA /SKIP IF NO MATCH ISZ DSTATE /INDICATE LOOKING FOR <LF> JMP GETMORE /KEEP GOING / FOUND <CR> AFTER COMMAND. FNDCR, TAD PUTEMP /GET THE CHARACTER TAD (-"J!300) /COMPARE TO <LF> SNA CLA /SKIP IF NO MATCH DCA DSTATE /RESET TO SCANNING STATE JMP GETMORE /KEEP GOING / FOUND OPENING DATA CHARACTER. FNDATA, TAD (-WIDTH) /SETUP THE DCA DATCNT /DATA COUNTER NL4000 /SETUP THE DCA DSTATE /NEW STATE JMP GETMORE /KEEP GOING / PROCESSING ONE OF 69 DATA CHARACTERS. STORDAT,TAD PUTEMP /GET THE CHARACTER TAD [-140] /SUBTRACT UPPER-CASE LIMIT SPA /SKIP IF LOWER-CASE TAD [40] /RESTORE UPPER-CASE TAD (100) /RESTORE THE CHARACTER DCA PUTEMP /SAVE IT BACK TAD PUTEMP /GET IT AGAIN TAD (-"Z!200-1) /SUBTRACT UPPER LIMIT CLL /CLEAR LINK FOR TEST TAD ("Z-"A+1) /ADD ON RANGE SZL CLA /SKIP IF NOT ALPHABETIC JMP ALPHAOK /JUMP IF ALPHABETIC TAD PUTEMP /GET THE CHARACTER TAD (-"9!200-1) /ADD ON UPPER LIMIT CLL /CLEAR LINK FOR TEST TAD ("9-"0+1) /ADD ON RANGE SNL CLA /SKIP IF OK JMP GETMORE /IGNORE IF NOT ALPHAOK,TAD PUTEMP /GET THE CHARACTER ISZ DATCNT /DONE 69 CHARACTERS? SKP /SKIP IF NOT ISZ DSTATE /ADVANCE TO NEXT STATE JMP I GETCHR /RETURN / PROCESSED 69 DATA CHARACTERS; NOW LOOKING FOR ENDING DATA CHARACTER. ENDATA, TAD PUTEMP /GET THE CHARACTER TAD (-">!200) /COMPARE TO ENDING DATA VALUE SNA CLA /SKIP IF NO MATCH ISZ DSTATE /ELSE ADVANCE TO NEXT STATE JMP GETMORE /KEEP GOING / FOUND ENDING DATA CHARACTER; NOW LOOKING FOR <CR>. ENDCR, TAD PUTEMP /GET THE CHARACTER TAD (-"M!300) /COMPARE TO <CR> SNA CLA /SKIP IF NO MATCH ISZ DSTATE /ELSE ADVANCE TO NEXT STATE JMP GETMORE /KEEP GOING / FOUND ENDING DATA CHARACTER AND <CR>; NOW LOOKING FOR <LF>. /ENDLF, TAD PUTEMP /GET THE CHARACTER / TAD (-"J!300) /COMPARE TO <LF> / SNA CLA /SKIP IF NO MATCH / DCA DSTATE /RESET TO SCANNING STATE / JMP GETMORE /KEEP GOING CLRCHKS,.-. /CLEAR CALCULATED CHECKSUM ROUTINE DCA CHKSUM+0 /CLEAR LOW-ORDER DCA CHKSUM+1 /CLEAR NEXT DCA CHKSUM+2 /CLEAR NEXT DCA CHKSUM+3 /CLEAR NEXT DCA CHKSUM+4 /CLEAR HIGH-ORDER JMP I CLRCHKSUM /RETURN PAGE GEOFILE,.-. /GET OUTPUT FILE ROUTINE TAD ODNUMBER /GET OUTPUT DEVICE NUMBER SZA CLA /SKIP IF NOT ESTABLISHED YET JMP GOTOD /JUMP IF DETERMINED ALREADY TAD ("D^100+"S-300) /GET BEGINNING OF "DSK" DCA DEVNAME /STORE IN-LINE TAD ("K^100) /GET REST OF "DSK" DCA DEVNAME+1 /STORE IN-LINE DCA RETVAL /CLEAR HANDLER ENTRY WORD CDF PRGFLD /INDICATE OUR FIELD CIF USRFLD /GOTO USR FIELD JMS I [USR] /CALL USR ROUTINE INQUIRE /INQUIRE ABOUT HANDLER DEVNAME,ZBLOCK 2 /WILL BE DEVICE DSK RETVAL, .-. /BECOMES HANDLER ENTRY POINT WORD HLT /DSK: NOT IN SYSTEM IS IMPOSSIBLE! TAD DEVNAME+1 /GET DEVICE NUMBER FOR DSK: AND [17] /JUST DEVICE BITS DCA ODNUMBER /STORE OUTPUT DEVICE GOTOD, CDF TBLFLD /BACK TO TABLE FIELD TAD I (OUTFILE+1) /GET OUTPUT FILE FIRST NAME WORD SNA /SKIP IF PRESENT JMP GFLNAME /JUMP IF NOT DCA FNAME /MOVE TO OUR AREA TAD I (OUTFILE+2) /GET SECOND NAME WORD DCA FNAME+1 /MOVE IT TAD I (OUTFILE+3) /GET THIRD NAME WORD DCA FNAME+2 /MOVE IT TAD I (OUTFILE+4) /GET EXTENSION WORD DCA FNAME+3 /MOVE IT GEOFXIT,CDF PRGFLD /BACK TO OUR FIELD JMP I GEOFILE /RETURN / WE MUST TAKE THE FILENAME FROM THE IMBEDDED (FILE ) COMMAND. THE ONLY / EXCEPTION IS IF WE ARE DOING AN IMAGE TRANSFER. GFLNAME,TAD I (SWAL) /GET /A-/L SWITCHES AND (10) /JUST /I BIT SZA CLA /SKIP IF NOT SET TAD I [EQUWRD] /GET EQUALS PARAMETER SNA /SKIP IF SET TO SOMETHING JMP DOFLNAME /JUMP IF PARAMETERS NOT SET CMA /INVERT IT DCA DANGCNT /STORE AS DANGER COUNT ISZ IMSW /SET IMAGE-MODE SWITCH TAD I [SWY9] /GET /Y-/9 SWITCHES AND (600) /JUST /1, /2 SWITCHES SNA /SKIP IF EITHER SET JMP GEOFXIT /JUMP IF NEITHER SET AND [400] /JUST /1 SWITCH SNA CLA /SKIP IF /1 SET JMP IM2 /JUMP IF /2 SET TAD I [EQUWRD] /GET EQUALS PARAMETER CLL RAR /%2 JMP IMCOMMON /CONTINUE THERE IM2, TAD I [EQUWRD] /GET EQUALS PARAMETER CLL RAR /%2 CIA /SUBTRACT PART 1 VALUE TAD I [EQUWRD] /FROM EQUALS PARAMETER IMCOMMO,CMA /INVERT IT DCA DANGCNT /STORE AS DANGER COUNT JMP GEOFXIT /EXIT THERE DOFLNAM,CDF PRGFLD /BACK TO OUR FIELD NL7777 /SETUP THE DCA INITFLAG /INPUT FILE INITIALIZATION JMS I (SCNFILE) /SCAN OFF "(FILE" / HAVING FOUND THE (FILE ) COMMAND, WE MUST FIND THE FILENAME. / ZERO OUT THE FILENAME AREA. TAD (-10) /SETUP THE DCA CHRCNT /CLEAR COUNTER TAD (ONAME-1) /SETUP THE DCA XR1 /POINTER JMS I (CLRNAME) /CLEAR THE NAME BUFFER / SETUP FOR SCANNING THE NAME PORTION. TAD (-6) /SETUP THE DCA CHRCNT /SCAN COUNT TAD (ONAME-1) /SETUP THE DCA XR1 /POINTER FNCAGN, JMS I (GETAN) /GET A CHARACTER JMP GOTSEPARATOR /GOT "."; GOTO NEXT FIELD DCA I XR1 /STASH THE CHARACTER ISZ CHRCNT /DONE ALL YET? JMP FNCAGN /NO, KEEP GOING / THROW AWAY EXTRA NAME CHARACTERS. TOSSNAM,JMS I (GETAN) /GET A CHARACTER JMP GOTSEPARATOR /GOT "."; GOTO NEXT FIELD JMP TOSSNAME /KEEP GOING / COMES HERE AFTER "." FOUND. GOTSEPA,JMS I (CLRNAME) /CLEAR OUT THE REMAINING NAME FIELD NL7776 /SETUP THE DCA CHRCNT /SCAN COUNT EXCAGN, JMS I (GETAN) /GET A CHARACTER JMP I [CHARERROR] /GOT "."; COMPLAIN DCA I XR1 /STASH THE CHARACTER ISZ CHRCNT /DONE ENOUGH YET? JMP EXCAGN /NO, KEEP GOING / TOSS ANY EXTRA EXTENSION CHARACTERS. TOSSEXT,JMS I (GETAN) /GET A CHARACTER JMP I [CHARERROR] /GOT "."; COMPLAIN JMP TOSSEXTENSION /KEEP GOING / COMES HERE WHEN TRAILING ")" IS FOUND. GOTRPAR,JMS I (CLRNAME) /CLEAR ANY REMAINING EXTENSION CHARACTERS TAD I (ONAME) /GET THE FIRST CHARACTER SNA CLA /SKIP IF SOMETHING THERE JMP I [CHARERROR] /COMPLAIN IF NONE THERE TAD (ONAME-1) /SETUP POINTER DCA XR1 /TO NAME CHARACTERS TAD (FNAME-1) /SETUP POINTER DCA XR2 /TO PACKED NAME AREA TAD (-4) /SETUP THE DCA CHRCNT /MOVE COUNT CHRLOOP,TAD I XR1 /GET FIRST CHARACTER CLL RTL;RTL;RTL /MOVE UP TAD I XR1 /ADD ON SECOND CHARACTER DCA I XR2 /STORE THE PAIR ISZ CHRCNT /DONE YET? JMP CHRLOOP /NO, KEEP GOING JMP I GEOFILE /YES, RETURN PAGE SCNFILE,.-. /SCAN "(FILE" ROUTINE MATAGN, JMS GETNSPC /GET A CHARACTER TAD (-"(!200) /COMPARE TO "(" SZA CLA /SKIP IF IT MATCHES JMP MATAGN /JUMP IF NOT JMS GETNSPC /GET NEXT CHARACTER TAD (-"F!300) /COMPARE TO "F" SZA CLA /SKIP IF IT MATCHES JMP MATAGN /JUMP IF NOT JMS GETNSPC /GET NEXT CHARACTER TAD (-"I!300) /COMPARE TO "I" SZA CLA /SKIP IF IT MATCHES JMP MATAGN /JUMP IF NOT JMS GETNSPC /GET NEXT CHARACTER TAD (-"L!300) /COMPARE TO "L" SZA CLA /SKIP IF IT MATCHES JMP MATAGN /JUMP IF NOT JMS GETNSPC /GET NEXT CHARACTER TAD (-"E!300) /COMPARE TO "E" SZA CLA /SKIP IF IT MATCHES JMP MATAGN /JUMP IF NOT JMP I SCNFILE /RETURN CLRNAME,.-. /NAME FIELD CLEARING ROUTINE TAD CHRCNT /GET CHARACTER COUNTER SNA CLA /SKIP IF ANY TO CLEAR JMP I CLRNAME /ELSE JUST RETURN DCA I XR1 /CLEAR A NAME WORD ISZ CHRCNT /COUNT IT JMP .-2 /KEEP GOING JMP I CLRNAME /RETURN GETNSPC,.-. /GET NON-<SPACE> CHARACTER GETNAGN,JMS GETCHAR /GET A CHARACTER TAD (-" !200) /COMPARE TO <SPACE> SNA CLA /SKIP IF OTHER JMP GETNAGN /JUMP IF IT MATCHES TAD PUTEMP /GET THE CHARACTER BACK JMP I GETNSPC /RETURN GETCHAR,.-. /GET A CHARACTER ROUTINE CLA /CLEAN UP TAD INITFLAG /GET INITIALIZE FLAG JMS I [GETBYTE] /GET A CHARACTER JMP I (NIOERROR) /COMPLAIN IF AN ERROR JMP I [CHARERROR] /COMPLAIN IF <EOF> REACHED TAD [-140] /COMPARE TO LOWER-CASE LIMIT SPA /SKIP IF LOWER-CASE TAD [40] /RESTORE ORIGINAL IF UPPER-CASE AND (77) /JUST SIX-BIT DCA PUTEMP /SAVE IN CASE WE NEED IT DCA INITFLAG /CLEAR INITIALIZE FLAG TAD PUTEMP /GET IT BACK JMP I GETCHAR /RETURN GETAN, .-. /GET ALPHANUMERIC ROUTINE JMS GETNSPC /GET A NON-<SPACE> CHARACTER TAD (-".!200) /COMPARE TO "." SNA /SKIP IF OTHER JMP I GETAN /TAKE FIRST RETURN IF IT MATCHES TAD (-")+".) /COMPARE TO ")" SNA /SKIP IF OTHER JMP I (GOTRPAREN) /TAKE DEDICATED RETURN IF IT MATCHES TAD (-":+")) /SUBTRACT UPPER LIMIT CLL /CLEAR LINK FOR TEST TAD (":-"0) /ADD ON RANGE SZL CLA /SKIP IF NOT NUMERIC JMP GETANOK /JUMP IF NUMERIC TAD PUTEMP /GET THE CHARACTER BACK TAD (-"[!300) /SUBTRACT UPPER LIMIT CLL /CLEAR LINK FOR TEST TAD ("[-"A) /ADD ON RANGE SNL CLA /SKIP IF ALPHABETIC JMP I [CHARERROR] /ELSE COMPLAIN GETANOK,TAD PUTEMP /GET GOOD ALPHANUMERIC CHARACTER ISZ GETAN /BUMP TO SKIP RETURN JMP I GETAN /RETURN ONAME, ZBLOCK 10 /OUTPUT NAME FIELD FENTER, .-. /FILE ENTER ROUTINE TAD (FNAME) /POINT TO DCA ENTAR1 /STORED FILENAME DCA ENTAR2 /CLEAR SECOND ARGUMENT TAD ODNUMBER /GET OUTPUT DEVICE NUMBER CIF USRFLD /GOTO USR FIELD JMS I [USR] /CALL USR ROUTINE ENTER /ENTER TENTATIVE FILENAME ENTAR1, .-. /WILL POINT TO FILENAME ENTAR2, .-. /WILL BE ZERO JMP I (ENTERR) /ENTER ERROR TAD ENTAR2 /GET RETURNED EMPTY LENGTH IAC /ADD 2-1 FOR OS/278 CRAZINESS DCA DANGCNT /STORE AS DANGER COUNT TAD ENTAR1 /GET RETURNED FIRST RECORD DCA OUTRECORD /SETUP OUTPUT RECORD JMP I FENTER /RETURN PAGE $ /THAT'S ALL FOLK!